perm filename CNTOUR.FAI[XGP,BGB] blob sn#033596 filedate 1973-05-11 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00007 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001	CNTOUR.FAI[XGP,TVR]
C00002 00002	SUBR(THRESH)------------------------------------------------------
C00004 00003	SUBR(HISTOG)---------------------------------------------------
C00005 00004	SUBR(MKPGON)LEVEL--------------------------------------------------
C00008 00005	THE SUB-OPERATIONS OF MKPGON.
C00009 00006	THE ALCHEMIST OF MKPGON - converts bits of lead into lines of gold.
C00012 00007	NSUBR(SETKINK)
C00013 ENDMK
C⊗;
SUBR(THRESH)------------------------------------------------------
BEGIN THRESH;THRESHOLD(LEVEL) pre foonly version. BGB 4 DEC 1972.
	SKIPE FLGKRK↔DETSEG
;SOUBIT TO PAC FOR PIXELS ≥ CUT.
	I←13 ↔ J←14
	CALL(SEGTV)
	MOVE [XWD L,2]↔BLT 13
	MOVE ARG1↔MOVEM HCUT
	HRR 5,ARG1
	GO 3

;ACCUMULATOR LOOP.
L:	POINT 6,TVBUF,-1
	MOVEI J,=36	;3
	ILDB 2		;4
	SUBI ;CUT	;5
	ROTC 1		;6
	SOJG J,4	;7
	SETCAM 1,PAC(I) ;10
	AOBJN I,3	;11
	POP1J		;12
	XWD -=1728,0	;13
BEND;12/17/72-----------------------------------------------------

HCUT:	0	;HCUT GLOBAL FROM THRESH TO MKPGONS.

SUBR(PACXOR)------------------------------------------------------
BEGIN PACXOR;do rook's exclusive OR'ing. BGB 4-DEC-72.
	I←2
	MOVSI PAC↔LAPI HSEG↔BLT HSEG+=1727
	MOVSI PAC↔LAPI VSEG↔BLT VSEG+=1727
	SETZ I,
	HRRI PAC↔HRRM L+2
L:	TRNN I,7↔SETZ 1,↔MOVE PAC(I)
	XORM HSEG+8(I)	; HSEG SOUBIT are above PAC bits.
	ROTC -1↔ROT 1,1
	XORM VSEG(I)	; VSEG are left of PAC bits.
	AOS I
	CAIE I,=1728
	GO L
	SETZM ISAVED
	POP0J
BEND;12/4/72------------------------------------------------------
SUBR(HISTOG)---------------------------------------------------
BEGIN HISTOG;MAKE HISTOGRAM OF TVBUF - BGB - 4 DEC 72.

	CALL(SEGTV)
	SKIPE FTVHIS↔POP0J↔SETOM FTVHIS
	MOVE[XWD HISTO,HISTO+1]↔SETZM HISTO↔BLT HISTO+77
	MOVE 10,[XWD L,0]↔BLT 10,7↔GO 2

;ACCUMULATOR LOOP.
L:	=62208		;0
	0		;1
	ILDB 1,6	;2
	AOS HISTO(1)	;3
	SOJG 0,2	;4
	POP0J		;5
	POINT 6,TVBUF,-1;6

BEND;12/16/72-----------------------------------------------------
SUBR(MKPGON)LEVEL--------------------------------------------------
BEGIN MKPGON;MAKE AN INTENSITY CONTOUR POLYGON - BGB - AUGUST 1972.

	ACCUMULATORS{A2,A3,RC.,MASK,I,PTR,D,E,V,PG,BITQ,H1,H2}
;	MOVE H1,HCUT↔LSH H1,-3↔MOVEI H2,7↔SUB H2,H1
	MOVE I,ISAVED↔HRRZ PTR,ARG1↔MOVEI BITQ,VREL
	MOVSI I↔HRRI PAC↔MOVEM PACPTR#; PAC POINTER INDEXED BY I.

;FIND THE ROW & COL OF THE UPPER LEFT MOST VSEG.
L1:	SKIPE 1,VSEG(I)↔GO L2
	AOS I↔CAIE I,=1728↔GO L1
	SETZ 1,↔POP1J;EMPTY.

L2:	MOVEM I,ISAVED↔JFFO 1,.+1↔MOVSI MASK,400000
	MOVNS 2↔LSH MASK,(2)↔MOVNS 2
	MOVE RC.,I↔ANDI RC.,7↔IMULI RC.,=36↔ADD RC.,2	;COLUMN.
	MOVE I↔LSH -3↔HRLM RC.↔LSH RC.,6			;ROW.

;DISTINGUISH BLOBS FROM HOLES.
	SETZM HOLE#
	TDNN MASK,@PACPTR		;HOLE OR BLOB ?
	SETOM HOLE#			;HOLE'A'COMING.
	SKIPE FNTFLG↔SETCMM HOLE	;COMPLIMENT HOLE FLAG FOR CHARACTERS FROM FONT
	SKIPE HOLE↔EXCH H1,H2

;AND HEAD SOUTH.

	SETQ(PG,{MAKE,[PBIT+PGNREL]})
	MOVE 0,ARG1↔DAD. 0,PG↔CALL(RINGIN,PG,0)
	SKIPE HOLE↔GO[MARK PG,HOLBIT↔GO .+1]
	MOVEM  RC.,RCMIN#
	SETZM RCMAX#
	SETZ V,↔SETZM ECNT#
	PUSHJ P,FOLLOW
	MOVE V,V0
	CCW. V,E↔CW. E,V

;MAKE & RETURN VIC POLYGON.

	MOVE 1,ECNT↔SKIPE HOLE#↔MOVNS 1
 	NCNT. 1,PG
	MOVE V0↔SON. 0,PG	;UPPER MOST LEFT.
	MOVE V1↔ARC. 0,PG	;LOWER MOST RIGHT.
	MOVE 1,PG
L3:	POP1J
;THE SUB-OPERATIONS OF MKPGON.

DEFINE	TRY (SEG,YES) {
	MOVE SEG(I)↔TDZN MASK↔GO .+3↔MOVEM SEG(I)↔GO YES}
DEFINE	LEFT	{SUBI RC.,100↔ROT MASK,1↔CAIN MASK,1↔SOS I}
DEFINE	RIGHT	{ADDI RC.,100↔ROT MASK,-1↔SKIPG MASK↔AOS I}
DEFINE	UP 	{SUB RC.,[1B11]↔SUBI I,8}
DEFINE	DOWN  	{ADD RC.,[1B11]↔ADDI I,8}

;CREATE NEW EDGE AND VERTEX OF A VIC.
TURN:	0
	AOS TURNS#
	ADD D,RC.
	AOS 2,ECNT

;VERTEX
	CALL MAKE,BITQ
	PGON. PG,1
	SKIPN V↔GO[MOVEM 1,V0#↔MOVEM 1,V↔GO T2]
	MOVEM 1,V
	CCW. V,E↔CW. E,V
T2:	MOVEM D,RC(V)
	CAMLE D,RCMAX
	GO[MOVEM D,RCMAX↔MOVEM V,V1#↔GO .+1]
	MOVEM V,E
	GO @TURN
;THE ALCHEMIST OF MKPGON - converts bits of lead into lines of gold.

NORTH:	ADD D,[1B11]↔LIPI BITQ,(NORBIT+VBIT)↔JSR TURN
;NORTH2:	LEFT↔MOVE D,DELPM(H1)↔	TRY HSEG,WEST
NORTH2:	LEFT↔MOVE D,DELPM↔	TRY HSEG,WEST
	RIGHT↔UP↔	TRY VSEG,NORTH2
;	DOWN↔MOVE D,DELPP(H2)↔	TRY HSEG,EAST↔FATAL(NORTH)
	DOWN↔MOVE D,DELPP↔	TRY HSEG,EAST↔FATAL(NORTH)
NORTH3:	LIPI BITQ,(NORBIT+VBIT)↔JSR TURN↔LEFT
;NORTH4:	UP↔MOVE D,DELPM(H1)↔	TRY HSEG,WEST↔GO NORTH4
NORTH4:	UP↔MOVE D,DELPM↔	TRY HSEG,WEST↔GO NORTH4


WEST:	ADDI D,100↔LIPI BITQ,(WESBIT+VBIT)↔JSR TURN
WEST2:	CAMN RC.,RCMIN↔POPJ P,;TRY FOR E.O.VIC.
;FOLLOW:	MOVE D,DELPP(H1)↔	TRY VSEG,SOUTH
FOLLOW:	MOVE D,DELPP↔	TRY VSEG,SOUTH
	LEFT↔		TRY HSEG,WEST2
;	RIGHT↔UP↔MOVE D,DELMP(H2)↔TRY VSEG,NORTH↔FATAL(WEST)
	RIGHT↔UP↔MOVE D,DELMP↔TRY VSEG,NORTH↔FATAL(WEST)


SOUTH:	LIPI BITQ,(SOUBIT+VBIT)↔JSR TURN
;SOUTH2:	DOWN↔MOVE D,DELMP(H1)
SOUTH2:	DOWN↔MOVE D,DELMP
	HLRZ RC.↔CAIN =216B29↔GO EAST3
			TRY HSEG, EAST
			TRY VSEG,SOUTH2
;	LEFT↔MOVE D,DELMM(H2)↔	TRY HSEG,WEST↔	FATAL(SOUTH)
	LEFT↔MOVE D,DELMM↔	TRY HSEG,WEST↔	FATAL(SOUTH)


EAST:	LIPI BITQ,(EASBIT+VBIT)↔JSR TURN
;EAST2:	RIGHT↔MOVE D,DELMM(H1)
EAST2:	RIGHT↔MOVE D,DELMM
	HRRZ RC.↔CAIN =288B29↔GO NORTH3
	UP↔		TRY VSEG,NORTH
	DOWN↔		TRY HSEG,EAST2
;	MOVE D,DELPM(H2)↔	TRY VSEG,SOUTH↔FATAL(EAST)
	MOVE D,DELPM↔	TRY VSEG,SOUTH↔FATAL(EAST)
EAST3:	LIPI BITQ,(EASBIT+VBIT)↔JSR TURN↔UP
;EAST4:	RIGHT↔MOVE D,DELMM(H1)
EAST4:	RIGHT↔MOVE D,DELMM
	HRRZ RC.↔CAIN =288B29↔GO[DOWN↔GO NORTH3]
			TRY VSEG,NORTH↔GO EAST4
BEND;12/14/72-----------------------------------------------------
NSUBR(SETKINK)
	CALL(REALIN)
	FIXX 0,
	JUMPE 0,[POP0J]
	MOVE 2,[XWD -4,DELPP]
LOOP:	HRRE 1,(2)
	JUMPL 1,[MOVN 1,0
		 HRRM 1,(2)
		 GO L1]
	HRRM 0,(2)
L1:	SKIPL (2)
	SKIPA 1,0
	MOVN 1,0
	HRLM 1,(2)
	AOBJN 2,LOOP
	POP0J
SUBREND SETKINK

;DEKINKING OFF SETS.
;	DELPP:	FOR I←24,33{XWD I,I↔}
;	DELPM:	FOR I←24,33{XWD I,-I↔}
;	DELMP:	FOR I←24,33{XWD -I,I↔}
;	DELMM:	FOR I←24,33{XWD -I,-I↔}

	INTERNAL DELPP
	DELPP:	XWD 22,22
	DELPM:	XWD 22,-22
	DELMP:	XWD -22,22
	DELMM:	XWD -22,-22